home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / MOTOROLA / 6805V107 / TESTER.PAS < prev   
Pascal/Delphi Source File  |  1988-05-08  |  11KB  |  367 lines
  1. program MC68705_Module_Tester;
  2. type
  3.    Str255=String[255];
  4.    filename = string[38];
  5.    filextn  = string[3];
  6.    symbol   = string[8];
  7.  
  8.    Regs  = record Case Integer of
  9.            1: (AX, BX, CX, DX, BP, SI, DI, DS, ES, Flags :integer);
  10.            2: (AL, AH, BL, BH, CL, CH, DL, DH            :byte);
  11.          End;
  12.  
  13.    oprec = record                                {Machine Opcode Table}
  14.       mnemonic : symbol;      {Op-code mnemonic}
  15.       stub,                   {Basic hex. opcode if +ve, or command if -ve}
  16.       modes    : integer;     {Addressing modes, bit-mapped}
  17.       end;
  18.    oplist      = array[1..127] of oprec; {Table of opcodes}
  19.  
  20.    ViewControl = (Initz, View, Finish);  {File-Viewer controls}
  21.  
  22. const
  23.    codefilename : filename    = '68705OPC.BIN';  {Name of op-codes file}
  24.    digit        : set of char = ['0'..'9'];
  25.    logline      : integer     = 16;              {Report line for subtasks}
  26.    filstem      = ' Default File: ';  {Flag work-file on screen}
  27.    srcextn      : filextn = 'SRC';    {Std. extension for Source files}
  28.    hexextn      : filextn = 'HEX';    {Std. extension for Hex. files}
  29.    comenv       = 'COMSPEC';          {Environment key - DOS Command}
  30.    wprenv       = 'WORDPATH';         {Environment key - Word Processor}
  31.  
  32.    version     : string[4] = '1.01';  {Assembler Version no.}
  33.  
  34.    whitespace  : set of char = [' ' , #9];
  35.    upper       : set of char = ['A'..'Z'];
  36.    lower       : set of char = ['a'..'z'];
  37.    nofile      : string[6]   = '<None>';    {Null file}
  38.  
  39.    TAB         : char = ^I;
  40.    CR          : char = ^M;
  41.    LF          : char = ^J;
  42.    ESC         : char = #27;
  43.    ENDFILE     : char = ^Z;
  44.  
  45. var
  46.    commandpath,                       {Path to DOS COMMAND processor}
  47.    wordprocpath,                      {Path to Word Processor, or null}
  48.    dfltname,                          {Main Default file name}
  49.    listname,                          {Assembler listing file}
  50.    srcname           : filename;      {and Primary source-file}
  51.    hexfile,                           {Hex. (Motorola) format File}
  52.    lstfile           : text;          {Listing File}
  53.  
  54.    memvalid,                          {Memory image holds a good program}
  55.    altered           : boolean;       {Memory image changed: needs saving}
  56.    today             : symbol;        {Current date, ex-DOS}
  57.    memmax,                            {Highest memory loc.}
  58.    oldsel,                            {Last sub-task run}
  59.    runjob,                            {Choose sub-task to run}
  60.    errcount          : integer;       {Count Assembler errors seen}
  61.    memory            : array[0..8191] of byte; {The MC68705 RAM & EPROM}
  62.    prefix            : string[80];    {Message frame - Asm. & Emulator}
  63.  
  64.  
  65. {*************** Hexadecimal Output (Listing) Routines *****************
  66.                   These all load results into PREFIX }
  67.  
  68. Procedure hexchar (loc :integer; value :byte);   {List 1 hex. character}
  69. const
  70.    hextab : array[0..15] of char =
  71.             ('0','1','2','3','4','5','6','7','8','9','A','B','C','D','E','F');
  72.  
  73. begin
  74.    prefix[loc]:= hextab[value and 15];
  75.    end;
  76.  
  77. Procedure hexbyte (loc :integer; value :byte);   {List 1 hex. byte}
  78. begin
  79.    hexchar(loc, value div 16);
  80.    hexchar(loc+1, value);
  81.    end;
  82.  
  83. Procedure hexword (loc, value :integer);         {List 1 hex. word}
  84. begin
  85.    hexbyte(loc  ,hi(value));
  86.    hexbyte(loc+2,lo(value));
  87.    end;
  88.  
  89. Function hex( a:char) :integer;      {Just the hex. value of 'a'}
  90. begin
  91.    if a in digit then
  92.       hex:= ord(a) - ord('0')
  93.    else if a in ['A'..'F'] then
  94.       hex:= ord(a) - ord('A') + 10
  95.    else
  96.       hex:= -1;
  97.    end;
  98.  
  99. Function date : symbol;              {Gets Date, as DD:MM:YY}
  100. var
  101.    registers  :Regs;                 {Machine registers for DOS call}
  102.    day, month :string[2];
  103.    year       :string[4];
  104.  
  105. begin
  106.    with registers do begin
  107.       AX := $2A00;                   {DOS call for Date}
  108.       INTR ($21, registers);         {To DOS}
  109.       str(CX:4,year);                {Unpack Year}
  110.       str(lo(DX):2,day);
  111.       str(hi(DX):2,month);           {Day & Month}
  112.       if (month[1] =' ') then month[1]:= '0'; {Leading zero in Month}
  113.       date:= day + ':' + month + ':' + copy(year,3,2);
  114.       end
  115.    end;
  116.  
  117.  
  118.  
  119. {************************** Main Program Routines ************************}
  120.  
  121. type
  122.    axis   = (xco,yco);
  123.    coord  = array[xco..yco] of integer;
  124.  
  125. const
  126.    horline   : byte = $cd;                 {Special screen chars. - effects}
  127.    verline   : byte = $ba;
  128.    topleft   : byte = $c9;
  129.    topright  : byte = $bb;
  130.    botleft   : byte = $c8;
  131.    botright  : byte = $bc;
  132.    midleft   : byte = $cc;
  133.    midright  : byte = $b9;
  134.    midtop    : byte = $cb;
  135.    midbot    : byte = $ca;
  136.    crossing  : byte = $ce;
  137.  
  138.    win1top   : coord = (2,4);              {Main screen windows}
  139.    win1bot   : coord = (27,24);
  140.    win2top   : coord = (37,4);
  141.    win2bot   : coord = (80,22);
  142.    win3top   : coord = (37,22);
  143.    win3bot   : coord = (80,24);
  144.  
  145.    cline     : integer = 8;              {No. of elements in "selector" array}
  146.  
  147. procedure choose(sel :integer);            {Display one choice}
  148. type
  149.    choice = string[20];
  150.  
  151. const
  152.    selector  : array[1..8] of choice =(
  153.                'Select Default File',
  154.                'Run DOS Command',
  155.                'Run Word Processor',
  156.                'Assembler',
  157.                'Execution Emulator',
  158.                'Load Exorciser file',
  159.                'Save Exorciser file',
  160.                'Exit to DOS' );
  161. begin
  162.    gotoxy(win1top[xco]+1,(2*sel)+win1top[yco]+2);
  163.    write(sel:2, '. ', selector[sel]);
  164.    end;
  165.  
  166. Function environment (arg :filename) : filename; {Get Environment String}
  167.   Type
  168.     Env=Array [0..32767] Of Char;
  169.   Var
  170.     EPtr: ^Env;
  171.     EStr: string[255];
  172.     Done: Boolean;
  173.     I: Integer;
  174.  
  175.   Begin
  176.     for i:= 1 to length(arg) do arg[i]:= upcase(arg[i]);  {Uppercase argt.}
  177.     EPtr:=Ptr(MemW[CSeg:$002C],0);
  178.     environment:= '';
  179.     I:=0;
  180.     Done:=False;
  181.     EStr:='';
  182.     Repeat
  183.       If EPtr^[I]=#0 Then
  184.        Begin
  185.         If EPtr^[I+1]=#0 Then Done:=True;
  186.         If Copy(EStr,1,length(arg)+1) = (arg + '=') then
  187.          Begin
  188.           environment:= copy(estr,length(arg)+2,100);
  189.           Done:=True;
  190.          End;
  191.         EStr:='';
  192.        End
  193.       Else EStr:=EStr+EPtr^[I];
  194.       I:=I+1;
  195.     Until Done;
  196.   End;
  197.  
  198. procedure showfile;                        {Display current file}
  199. var
  200.    xpt, scol  : integer;
  201. begin
  202.    scol:= win3top[xco]+length(filstem)+1;
  203.    highvideo;
  204.    gotoxy(scol, win3top[yco]+1);
  205.    for xpt:= scol to win3bot[xco]-1 do write(' '); {Selective blank-out}
  206.    gotoxy(scol, win3top[yco]+1);
  207.    write(dfltname);
  208.    end;
  209.  
  210. procedure setwin(topgap :integer);         {Set a reduced-size window}
  211. begin
  212.    window ( win2top[xco]+1, win2top[yco]+topgap+1,
  213.             win2bot[xco]-1, win2bot[yco]-1);
  214.    end;
  215.  
  216.  
  217. procedure showsel(level :integer);         {Display Main-Menu choices}
  218. var
  219.    ctr : integer;
  220.  
  221. begin
  222.    window(1,1,80,25);                      {Window controls OFF}
  223.  
  224.    if (level = 0) then begin               {Zero: re-display everything}
  225.       lowvideo;
  226.       for ctr:= 1 to cline do choose(ctr);     {Main menu choices}
  227.       end
  228.    else if (level > 0) then begin          {Positive: One in highlight}
  229.       highvideo;
  230.       choose(level);
  231.       end
  232.    else begin                              {Negative: One in background}
  233.       lowvideo;
  234.       choose(-level);
  235.       end;
  236.  
  237.    window(win2top[xco]+1, win2top[yco]+1,  {Then reset working window}
  238.           win2bot[xco]-1, win2bot[yco]-1);
  239.    end;
  240.  
  241. procedure vbar(start, finish :coord);      {Draws a vertical bar on screen}
  242. var                                        {OMITTING the given end-points}
  243.    y    : integer;
  244.  
  245. begin
  246.    for y:= start[yco]+1 to finish[yco]-1 do begin
  247.       gotoxy(start[xco], y);
  248.       write(chr(verline));
  249.       end
  250.    end;
  251.  
  252. procedure hbar(start, finish :coord);      {Draws horizontal bar on screen}
  253. var                                        {OMITTING the given end-points}
  254.    x    : integer;
  255.  
  256. begin
  257.    gotoxy(start[xco]+1, start[yco]);
  258.    for x:= start[xco]+1 to finish[xco]-1 do write(chr(horline));
  259.    end;
  260.  
  261. procedure drawwindow(tlt, brt :coord);     {Draws rectangular box on screen}
  262. var
  263.    x            : integer;
  264.    diagl, diagr : coord;
  265.    waste        : char;
  266.  
  267. begin                                      {Find the diagonal points}
  268.    diagl:= tlt;     diagl[yco]:= brt[yco];
  269.    diagr:= brt;     diagr[yco]:= tlt[yco];
  270.                                            {Do the corners}
  271.    gotoxy(tlt[xco],   tlt[yco]);   write(chr(topleft));
  272.    gotoxy(diagl[xco], diagl[yco]); write(chr(botleft));
  273.    gotoxy(diagr[xco], diagr[yco]); write(chr(topright));
  274.    gotoxy(brt[xco],   brt[yco]);   write(chr(botright));
  275.  
  276.    hbar(tlt,diagr);                        {Two horizontal bars}
  277.    hbar(diagl,brt);
  278.  
  279.    vbar(tlt,diagl);                        {Two vertical bars}
  280.    vbar(diagr,brt);
  281.    end;
  282.  
  283. {**************************************************************************
  284.  
  285.             S U B  -  T A S K   P R O C E D U R E S
  286.  
  287. ***************************************************************************}
  288.  
  289. function stdfile(extn :filextn) :filename;   {Standard file extn.}
  290. var
  291.    x      : integer;
  292.    tmp    : filename;
  293. begin
  294.    tmp:= dfltname;
  295.    x:= pos('.',dfltname);
  296.    if (((extn <> srcextn) or (x = 0)) and (tmp <> '')) then begin
  297.       if (x > 0) then tmp:= copy(dfltname,1,x-1);
  298.       tmp:= tmp + '.' + extn;
  299.       end;
  300.    stdfile:= tmp;
  301.    end;
  302.  
  303. function workfile ( line :integer;           {Line to put query on}
  304.                    usage :filename;          {Prompt string}
  305.                     extn :filextn)           {Default name extension}
  306.                          :filename;          {Makes correct file name}
  307. var
  308.    work : filename;
  309.    wcol : integer;
  310.  
  311. begin
  312.    gotoxy(2,line);
  313.    lowvideo;
  314.    write(usage:8, ' name: [');
  315.    wcol:= wherex;
  316.    highvideo;
  317.    write(stdfile(extn));
  318.    lowvideo;
  319.    writeln(']');
  320.    gotoxy(wcol-1,line+1);
  321.    write('>');
  322.    highvideo;
  323.    readln(work);
  324.    if (work = '') then work:= stdfile(extn);
  325.    if ((pos('.', work) =0) and
  326.        (work[length(work)] <> ':'))  then work:= work + '.' + extn;
  327.    gotoxy(wcol,line+1);
  328.    write(work);
  329.    workfile:= work;
  330.    end;
  331.  
  332. function accept(line :integer) :boolean;   {User confirms task}
  333. var
  334.    ans  : char;
  335.    pos  : integer;
  336.  
  337. begin
  338.    highvideo;
  339.    gotoxy(2,line);
  340.    write('OK to Proceed [Y/CR or N]: ');
  341.    pos:= wherex;
  342.    read(kbd,ans);
  343.    while (not (ans in ['Y', 'N', 'y', 'n', CR])) do begin
  344.       gotoxy(2, line+1);
  345.       write('"Y", CR, or "N", please');
  346.       gotoxy(pos, line);
  347.       read(kbd,ans);
  348.       end;
  349.    if (upcase(ans) in ['Y', 'y', CR]) then
  350.       accept:= true
  351.    else begin
  352.       accept:= false;
  353.       prefix:= 'Cancelled by User';
  354.       end
  355.    end;
  356.  
  357. {$I 68705SVC.PAS}
  358. {$I 68705VIW.PAS}
  359. {$I 68705DBG.PAS}
  360.  
  361. begin
  362.    memmax:= 2047;             {Test fix only}
  363.    writeln;
  364.    writeln('Viewer File (or "<None>"):'); readln(listname);
  365.    DoEmulation;
  366.    end.
  367.